home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdFileSystem.mod < prev    next >
Text File  |  1993-08-15  |  19KB  |  731 lines
  1. (*-------------------------------------------------------------------------
  2.  
  3.   Amiga Oberon Library Module: FileSystem
  4.   Adapted for AmokEd!!
  5.  
  6.   © 1990 by Fridtjof Siebert
  7.  
  8. :Date: 27 Aug 1991 18:16:05
  9. :History.    Mai 1991 Volker Rudolph +ReadStringLen
  10. :History. 08 Aug 1991 hartmut Goebel +ReadStringLenTab
  11. -------------------------------------------------------------------------*)
  12.  
  13. (*-------------------------------------------------------------------------
  14.  
  15.    Dieses Modul erleichtert das Arbeiten mit Dateien. Es stellt Prozeduren
  16.    zur Dateiverwaltung zur Verfügung.
  17.  
  18.    Die Geschwindigkeit liegt normalerweise über der von Dos, da beim Lesen
  19.    und Schreiben Puffer verwendet werden.
  20.  
  21.    Die Prozeduren, die ein boolsches Ergebnis liefern, waren immer
  22.    erfolgreich, wenn sie TRUE zurückliefern. Ansonsten steht in der
  23.    Variable File.status die Fehlernummer, die eine genauere Diagnose der
  24.    Fehlerursache erlaubt.
  25.  
  26.    Die Prozedur Delete() macht das gleiche wie Close(), löscht danach aber
  27.    die bearbeitete Datei.
  28.  
  29. -------------------------------------------------------------------------*)
  30. (* $Debug- *)
  31. MODULE EdFileSystem;
  32.  
  33. IMPORT d*: Dos,
  34.        sd: EdSecureDos;
  35.  
  36. CONST
  37.   BufSize = 1024;
  38.  
  39. (* File.status: *)
  40.  
  41.   ok        * = 0;  (* alles in Ordnung   *)
  42.   eof       * = 1;  (* Dateiende erreicht *)
  43.   readerr   * = 2;  (* Lesefehler         *)
  44.   writeerr  * = 3;  (* Schreibfehler      *)
  45.   onlyread  * = 4;  (* aus Datei darf nur gelesen werden    *)
  46.   onlywrite * = 5;  (* in Datei darf nur geschrieben werden *)
  47.   toofar    * = 6;  (* mit Move, Forward oder Backward zu weit gesprungen *)
  48.   outofmem  * = 7;  (* kein freier Speicher mehr *)
  49.   cantopen  * = 8;  (* konnte Datei nicht öffnen *)
  50.   cantlock  * = 9;  (* konnte Datei nicht locken *)
  51.  
  52. TYPE
  53.   FilePtr * = POINTER TO File;
  54.   File * = RECORD
  55.  
  56.              handle * : d.FileHandlePtr;
  57.              status * : INTEGER;
  58.              write  * : BOOLEAN;
  59.              read   * : BOOLEAN;
  60.              name   * : ARRAY 256 OF CHAR;
  61.  
  62.              buffer : POINTER TO ARRAY BufSize OF BYTE;
  63.              bufpos : INTEGER;
  64.              buflen : LONGINT;
  65.              pos    : LONGINT;
  66.              size   : LONGINT;
  67.              lastRead : BOOLEAN;
  68.            END;
  69.  
  70. VAR
  71.   info: d.FileInfoBlock;
  72.  
  73.  
  74. (*-------------------------------------------------------------------------*)
  75.  
  76.  
  77. (*------  Open:  ------*)
  78.  
  79.  
  80. PROCEDURE Open*(VAR file: File;
  81.                     name: ARRAY OF CHAR;
  82.                     write: BOOLEAN): BOOLEAN;
  83.  
  84. (* öffnet die Datei mit dem Namen 'name'. Ist write TRUE, wird die Datei
  85.    neu erzeugt und zum Schreiben geöffnet. Sonst wird sie zum Lesen
  86.    geöffnet. Das Ergebnis ist TRUE, wenn alles ordnungsgemäß verlief. *)
  87.  
  88. VAR
  89.   mode: INTEGER;
  90.   lock: d.FileLockPtr;
  91.  
  92. BEGIN
  93.   file.buffer := NIL; file.handle := NIL; lock := NIL;
  94.   LOOP
  95.     NEW(file.buffer); IF file.buffer=NIL THEN file.status := outofmem; EXIT END;
  96.     COPY(name,file.name);
  97.     IF write THEN mode := d.newFile
  98.              ELSE mode := d.oldFile END;
  99.     file.handle := sd.Open(name,mode);
  100.     IF file.handle = NIL THEN file.status := cantopen; EXIT END;
  101.     IF write THEN
  102.       file.size := 0;
  103.     ELSE
  104.       lock := sd.Lock(name,d.sharedLock);
  105.       IF lock=NIL                 THEN file.status := cantlock; EXIT END;
  106.       IF NOT d.Examine(lock,info) THEN file.status := cantlock; EXIT END;
  107.       file.size := info.size;
  108.       sd.UnLock(lock);
  109.     END;
  110.     file.bufpos := 0;
  111.     file.buflen := 0;
  112.     file.pos    := 0;
  113.     file.write  := write;
  114.     file.read   := ~ write;
  115.     file.status := ok;
  116.     RETURN TRUE;
  117.   END;
  118.   IF file.buffer#NIL THEN DISPOSE(file.buffer) END;
  119.   IF file.handle#NIL THEN sd.Close(file.handle); file.handle := NIL END;
  120.   IF lock#NIL THEN sd.UnLock(lock) END;
  121.   RETURN FALSE;
  122. END Open;
  123.  
  124.  
  125. (*------  OpenReadWrite:  ------*)
  126.  
  127.  
  128. PROCEDURE OpenReadWrite*(VAR file: File;
  129.                          name: ARRAY OF CHAR): BOOLEAN;
  130.  
  131. (* öffnet die Datei mit dem Namen 'name' zum wechselnd schreibenden
  132.    und lesenden Zugriff. Das Ergebnis ist TRUE, wenn alles
  133.    ordnungsgemäß verlief. *)
  134.  
  135. VAR
  136.   lock: d.FileLockPtr;
  137.  
  138. BEGIN
  139.   file.buffer := NIL; file.handle := NIL; lock := NIL;
  140.   LOOP
  141.     NEW(file.buffer); IF file.buffer=NIL THEN file.status := outofmem; EXIT END;
  142.     COPY(name,file.name);
  143.     file.handle := sd.Open(name,d.oldFile);
  144.     IF file.handle # NIL THEN
  145.       lock := sd.Lock(name,d.sharedLock);
  146.       IF lock=NIL                 THEN file.status := cantlock; EXIT END;
  147.       IF NOT d.Examine(lock,info) THEN file.status := cantlock; EXIT END;
  148.       file.size := info.size;
  149.       sd.UnLock(lock);
  150.     ELSE
  151.       file.handle := sd.Open(name,d.newFile);
  152.       IF file.handle = NIL THEN file.status := cantopen; EXIT END;
  153.       file.size := 0;
  154.     END;
  155.     file.bufpos := 0;
  156.     file.buflen := 0;
  157.     file.pos    := 0;
  158.     file.write  := TRUE;
  159.     file.read   := TRUE;
  160.     file.status := ok;
  161.     RETURN TRUE;
  162.   END;
  163.   IF file.buffer#NIL THEN DISPOSE(file.buffer) END;
  164.   IF file.handle#NIL THEN sd.Close(file.handle); file.handle := NIL END;
  165.   IF lock#NIL THEN sd.UnLock(lock) END;
  166.   RETURN FALSE;
  167. END OpenReadWrite;
  168.  
  169.  
  170. PROCEDURE WriteBuf(VAR file: File): BOOLEAN;
  171.  
  172. VAR i,j,l: INTEGER;
  173.  
  174. BEGIN
  175.   i := 0; j := file.bufpos; file.bufpos := 0;
  176.   REPEAT
  177.     l := SHORT(d.Write(file.handle,file.buffer[i],j));
  178.     IF l<0 THEN
  179.       file.status := writeerr;
  180.       RETURN FALSE
  181.     END;
  182.     INC(i,l); DEC(j,l);
  183.   UNTIL j<=0;
  184.   file.status := ok;
  185.   RETURN TRUE;
  186. END WriteBuf;
  187.  
  188.  
  189.  
  190. PROCEDURE EmptyWriteBuf(VAR file: File): BOOLEAN;
  191.  
  192. BEGIN
  193.   IF file.write AND (file.bufpos#0) THEN RETURN WriteBuf(file) END;
  194.   file.status := ok;
  195.   RETURN TRUE;
  196. END EmptyWriteBuf;
  197.  
  198.  
  199. (*------  Close:  ------*)
  200.  
  201.  
  202. PROCEDURE Close*(VAR file: File): BOOLEAN;
  203.  
  204. (* schließt die Datei file. Ergebnis ist TRUE, wenn alles korrekt verlief.
  205. *)
  206.  
  207. VAR res: BOOLEAN;
  208.  
  209. BEGIN
  210.   file.status := ok;
  211.   res := TRUE;
  212.   IF file.write AND (NOT file.read OR NOT file.lastRead) THEN
  213.     res := EmptyWriteBuf(file);
  214.     file.bufpos := 0;
  215.     file.buflen := 0;
  216.     file.lastRead := TRUE;
  217.   END;
  218.   sd.Close(file.handle); file.handle := NIL;
  219.   DISPOSE(file.buffer);
  220.   RETURN res;
  221. END Close;
  222.  
  223.  
  224. (*-------------------------------------------------------------------------*)
  225.  
  226.  
  227. (*------  Read:  ------*)
  228.  
  229.  
  230. PROCEDURE Read*(VAR file: File; VAR to: ARRAY OF BYTE): BOOLEAN;
  231.  
  232. (* liest LEN(to) Bytes aus file nach to. Ergebnis ist TRUE, wenn alles
  233. korrekt verlieft. *)
  234.  
  235. VAR
  236.   cnt: INTEGER;
  237.   bufpos: INTEGER;
  238.  
  239. BEGIN
  240.   IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  241.   IF file.write AND NOT file.lastRead THEN
  242.     IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
  243.     file.bufpos := 0;
  244.     file.buflen := 0;
  245.     file.lastRead := TRUE;
  246.   END;
  247.   cnt := 0; bufpos := file.bufpos;
  248.   WHILE cnt<LEN(to) DO
  249.     IF (bufpos=file.buflen) THEN
  250.       file.bufpos := 0; bufpos := 0;
  251.       file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  252.       IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
  253.       IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
  254.     END;
  255.     to[cnt] := file.buffer[bufpos];
  256.     INC(cnt); INC(bufpos);
  257.   END;
  258.   file.bufpos := bufpos;
  259.   INC(file.pos,cnt);
  260.   file.status := ok;
  261.   RETURN TRUE;
  262. END Read;
  263.  
  264.  
  265. (*------  ReadChar:  ------*)
  266.  
  267.  
  268. PROCEDURE ReadChar*(VAR file: File; VAR ch: CHAR): BOOLEAN;
  269.  
  270. (* liest ein Zeichen aus file. Ergebnis ist TRUE, wenn alles korrekt
  271. verlieft. *)
  272.  
  273. BEGIN
  274.   IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  275.   IF file.write AND NOT file.lastRead THEN
  276.     IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
  277.     file.bufpos := 0;
  278.     file.buflen := 0;
  279.     file.lastRead := TRUE;
  280.   END;
  281.   IF (file.bufpos=file.buflen) THEN
  282.     file.bufpos := 0;
  283.     file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  284.     IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
  285.     IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
  286.   END;
  287.   ch := file.buffer[file.bufpos];
  288.   INC(file.bufpos);
  289.   INC(file.pos);
  290.   file.status := ok;
  291.   RETURN TRUE;
  292. END ReadChar;
  293.  
  294.  
  295. (*------  ReadString:  ------*)
  296.  
  297.  
  298. PROCEDURE ReadString*(VAR file: File; VAR to: ARRAY OF CHAR): BOOLEAN;
  299.  
  300. (* liest einen String aus file nach to. Stringende ist durch 0X oder 0AX
  301. markiert. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)
  302.  
  303. VAR
  304.   cnt: INTEGER;
  305.   bufpos: INTEGER;
  306.   eos: BOOLEAN;
  307.  
  308. BEGIN
  309.   IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  310.   IF file.write AND NOT file.lastRead THEN
  311.     IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
  312.     file.bufpos := 0;
  313.     file.buflen := 0;
  314.     file.lastRead := TRUE;
  315.   END;
  316.   cnt := 0; bufpos := file.bufpos; eos := FALSE;
  317.   WHILE (cnt<LEN(to)) AND NOT eos DO
  318.     IF (bufpos=file.buflen) THEN
  319.       file.bufpos := 0; bufpos := 0;
  320.       file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  321.       IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
  322.       IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
  323.     END;
  324.     to[cnt] := file.buffer[bufpos];
  325.     CASE to[cnt] OF 0X,0AX: eos := TRUE; to[cnt] := 0X | ELSE END;
  326.     INC(cnt); INC(bufpos);
  327.   END;
  328.   file.bufpos := bufpos;
  329.   INC(file.pos,cnt);
  330.   file.status := ok;
  331.   RETURN TRUE;
  332. END ReadString;
  333.  
  334. PROCEDURE ReadStringLen*(VAR file: File; VAR to: ARRAY OF CHAR): INTEGER;
  335.  
  336. (* liest einen String aus file nach to. Stringende ist durch 0X oder 0AX
  337. markiert. Ergebnis ist str.Length(to), wenn alles korrekt verlieft. *)
  338.  
  339. VAR
  340.   cnt: INTEGER;
  341.   bufpos: INTEGER;
  342.   eos: BOOLEAN;
  343.  
  344. BEGIN
  345.   IF NOT file.read THEN file.status := onlywrite; RETURN -1 END;
  346.   IF file.write AND NOT file.lastRead THEN
  347.     IF NOT EmptyWriteBuf(file) THEN RETURN -1 END;
  348.     file.bufpos := 0;
  349.     file.buflen := 0;
  350.     file.lastRead := TRUE;
  351.   END;
  352.   cnt := 0; bufpos := file.bufpos; eos := FALSE;
  353.   WHILE (cnt<LEN(to)) AND NOT eos DO
  354.     IF (bufpos=file.buflen) THEN
  355.       file.bufpos := 0; bufpos := 0;
  356.       file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  357.       IF file.buflen=0 THEN file.status := eof;     RETURN -1 END;
  358.       IF file.buflen<0 THEN file.status := readerr; RETURN -1 END;
  359.     END;
  360.     to[cnt] := file.buffer[bufpos];
  361.     INC(bufpos);
  362.     CASE to[cnt] OF
  363.       0X,0AX: eos := TRUE; to[cnt] := 0X |
  364.     ELSE
  365.       INC(cnt);
  366.     END;
  367.   END;
  368.   file.bufpos := bufpos;
  369.   INC(file.pos,cnt);
  370.   file.status := ok;
  371.   RETURN cnt;
  372. END ReadStringLen;
  373.  
  374. (* $Debug= *)
  375. PROCEDURE ReadStringLenTab*(VAR file: File; VAR to: ARRAY OF CHAR;
  376.                             tabStop: INTEGER): INTEGER;
  377.  
  378. (* liest einen String aus file nach to, Tabs werden          *)
  379. (* expantiert. Stringende ist durch 0X oder 0AX markiert.    *)
  380. (* Ergebnis ist str.Length(to), wenn alles korrekt verlieft. *)
  381.  
  382. VAR
  383.   cnt, bufcnt: INTEGER;
  384.   bufpos: INTEGER;
  385.   i, j: INTEGER;
  386.   eos: BOOLEAN;
  387.  
  388. BEGIN
  389.   IF NOT file.read THEN file.status := onlywrite; RETURN -1 END;
  390.   IF file.write AND NOT file.lastRead THEN
  391.     IF NOT EmptyWriteBuf(file) THEN RETURN -1 END;
  392.     file.bufpos := 0;
  393.     file.buflen := 0;
  394.     file.lastRead := TRUE;
  395.   END;
  396.   cnt := 0; bufcnt := 0; bufpos := file.bufpos; eos := FALSE;
  397.   WHILE (cnt<LEN(to)) AND NOT eos DO
  398.     IF (bufpos=file.buflen) THEN
  399.       file.bufpos := 0; bufpos := 0;
  400.       file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  401.       IF file.buflen=0 THEN file.status := eof;     RETURN -1 END;
  402.       IF file.buflen<0 THEN file.status := readerr; RETURN -1 END;
  403.     END;
  404.     to[cnt] := file.buffer[bufpos];
  405.     INC(bufpos); INC(bufcnt);
  406.     CASE to[cnt] OF
  407.       "\t": i := tabStop-(cnt MOD tabStop)+cnt;
  408.             IF i>=LEN(to) THEN
  409.               i := LEN(to)-1;
  410.               to[i] := "\o"; eos := TRUE;
  411.             END;
  412.             j := i;
  413.             REPEAT
  414.               DEC(i);
  415.               to[i] := " ";
  416.             UNTIL i <= cnt;
  417.             cnt := j;
  418.     | 0X,0AX: eos := TRUE; to[cnt] := 0X;
  419.     ELSE
  420.       INC(cnt);
  421.     END;
  422.   END;
  423.   file.bufpos := bufpos;
  424.   INC(file.pos,bufcnt);
  425.   file.status := ok;
  426.   RETURN cnt;
  427. END ReadStringLenTab;
  428. (* $Debug- *)
  429.  
  430. (*------  ReadBlock:  ------*)
  431.  
  432.  
  433. PROCEDURE ReadBlock*(VAR file: File; to, size: LONGINT): BOOLEAN;
  434.  
  435. (* liest size Bytes aus file nach to^. Ergebnis ist TRUE, wenn alles
  436. korrekt verlieft. *)
  437.  
  438. VAR
  439.   cnt: LONGINT;
  440.   bufpos: INTEGER;
  441.   ptrtob: POINTER TO BYTE;
  442.  
  443. BEGIN
  444.   IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  445.   IF file.write AND NOT file.lastRead THEN
  446.     IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
  447.     file.bufpos := 0;
  448.     file.buflen := 0;
  449.     file.lastRead := TRUE;
  450.   END;
  451.   ptrtob := to;
  452.   cnt := 0; bufpos := file.bufpos;
  453.   WHILE cnt<size DO
  454.     IF (bufpos=file.buflen) THEN
  455.       file.bufpos := 0; bufpos := 0;
  456.       file.buflen := d.Read(file.handle,file.buffer^,BufSize);
  457.       IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
  458.       IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
  459.     END;
  460.     ptrtob^ := file.buffer[bufpos];
  461.     INC(cnt); INC(ptrtob); INC(bufpos);
  462.   END;
  463.   file.bufpos := bufpos;
  464.   INC(file.pos,size);
  465.   file.status := ok;
  466.   RETURN TRUE;
  467. END ReadBlock;
  468.  
  469.  
  470. (*-------------------------------------------------------------------------*)
  471.  
  472.  
  473. (*------  Write:  ------*)
  474.  
  475.  
  476. PROCEDURE Write*(VAR file: File; from: ARRAY OF BYTE): BOOLEAN;
  477.  
  478. (* schreibt LEN(to) Bytes aus from in die Datei file. Ergebnis ist TRUE,
  479. wenn alles korrekt verlieft. *)
  480.  
  481. VAR
  482.   cnt: INTEGER;
  483.   bufpos: INTEGER;
  484.  
  485. BEGIN
  486.   IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  487.   IF file.read AND file.lastRead THEN
  488.     IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
  489.     file.bufpos := 0;
  490.     file.buflen := 0;
  491.     file.lastRead := FALSE;
  492.   END;
  493.   cnt := 0; bufpos := file.bufpos;
  494.   WHILE cnt<LEN(from) DO
  495.     IF (bufpos=BufSize) THEN
  496.       file.bufpos := bufpos;
  497.       bufpos := 0;
  498.       IF NOT WriteBuf(file) THEN RETURN FALSE END;
  499.     END;
  500.     file.buffer[bufpos] := from[cnt];
  501.     INC(cnt); INC(bufpos);
  502.   END;
  503.   file.bufpos := bufpos;
  504.   INC(file.pos,cnt);
  505.   IF file.pos>file.size THEN file.size := file.pos END;
  506.   file.status := ok;
  507.   RETURN TRUE;
  508. END Write;
  509.  
  510.  
  511. (*------  WriteChar:  ------*)
  512.  
  513.  
  514. PROCEDURE WriteChar*(VAR file: File; ch: CHAR): BOOLEAN;
  515.  
  516. (* schreibt 1 Char in die Datei file. Ergebnis ist TRUE, wenn alles korrekt
  517. verlieft. *)
  518.  
  519. BEGIN
  520.   IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  521.   IF file.read AND file.lastRead THEN
  522.     IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
  523.     file.bufpos := 0;
  524.     file.buflen := 0;
  525.     file.lastRead := FALSE;
  526.   END;
  527.   IF file.bufpos=BufSize THEN
  528.     IF NOT WriteBuf(file) THEN RETURN FALSE END;
  529.   END;
  530.   file.buffer[file.bufpos] := ch;
  531.   INC(file.bufpos);
  532.   INC(file.pos);
  533.   IF file.pos>file.size THEN file.size := file.pos END;
  534.   file.status := ok;
  535.   RETURN TRUE;
  536. END WriteChar;
  537.  
  538.  
  539. (*------  WriteString:  ------*)
  540.  
  541.  
  542. PROCEDURE WriteString*(VAR file: File; from: ARRAY OF CHAR): BOOLEAN;
  543.  
  544. (* schreibt String in die Datei. Danach wird eine LF in die Datei
  545. geschrieben. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)
  546.  
  547. VAR
  548.   cnt: INTEGER;
  549.   bufpos: INTEGER;
  550.   eos: BOOLEAN;
  551.  
  552. BEGIN
  553.   IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  554.   IF file.read AND file.lastRead THEN
  555.     IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
  556.     file.bufpos := 0;
  557.     file.buflen := 0;
  558.     file.lastRead := FALSE;
  559.   END;
  560.   cnt := 0; bufpos := file.bufpos; eos := FALSE;
  561.   WHILE (cnt<LEN(from)) AND NOT eos DO
  562.     IF (bufpos=BufSize) THEN
  563.       file.bufpos := bufpos;
  564.       bufpos := 0;
  565.       IF NOT WriteBuf(file) THEN RETURN FALSE END;
  566.     END;
  567.     IF from[cnt] = 0X THEN
  568.       eos := TRUE;
  569.       file.buffer[bufpos] := 0AX;
  570.     ELSE
  571.       file.buffer[bufpos] := from[cnt];
  572.     END;
  573.     INC(cnt); INC(bufpos);
  574.   END;
  575.   file.bufpos := bufpos;
  576.   INC(file.pos,cnt);
  577.   IF file.pos>file.size THEN file.size := file.pos END;
  578.   file.status := ok;
  579.   RETURN TRUE;
  580. END WriteString;
  581.  
  582.  
  583. (*------  WriteBlock:  ------*)
  584.  
  585.  
  586. PROCEDURE WriteBlock*(VAR file: File; from, size: LONGINT): BOOLEAN;
  587.  
  588. (* schreibt size Bytes aus from^ in die Datei file. Ergebnis ist TRUE, wenn
  589. alles korrekt verlieft. *)
  590.  
  591. VAR
  592.   cnt: LONGINT;
  593.   bufpos: INTEGER;
  594.   ptrtob: POINTER TO BYTE;
  595.  
  596. BEGIN
  597.   IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  598.   IF file.read AND file.lastRead THEN
  599.     IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
  600.     file.bufpos := 0;
  601.     file.buflen := 0;
  602.     file.lastRead := FALSE;
  603.   END;
  604.   cnt := 0; bufpos := file.bufpos; ptrtob := from;
  605.   WHILE cnt<size DO
  606.     IF (bufpos=BufSize) THEN
  607.       file.bufpos := bufpos;
  608.       bufpos := 0;
  609.       IF NOT WriteBuf(file) THEN RETURN FALSE END;
  610.     END;
  611.     file.buffer[bufpos] := ptrtob^;
  612.     INC(cnt); INC(bufpos); INC(ptrtob);
  613.   END;
  614.   file.bufpos := bufpos;
  615.   INC(file.pos,cnt);
  616.   IF file.pos>file.size THEN file.size := file.pos END;
  617.   file.status := ok;
  618.   RETURN TRUE;
  619. END WriteBlock;
  620.  
  621.  
  622. (*-------------------------------------------------------------------------*)
  623.  
  624.  
  625. (*------  Size:  ------*)
  626.  
  627.  
  628. PROCEDURE Size*(VAR file: File): LONGINT;
  629.  
  630. (* Ergibt die Größe der Datei *)
  631.  
  632. BEGIN
  633.   RETURN file.size;
  634. END Size;
  635.  
  636.  
  637. (*------  Position:  ------*)
  638.  
  639.  
  640. PROCEDURE Position* (VAR file: File): LONGINT;
  641.  
  642. (* Ergibt die aktuelle Position innerhalb der Datei *)
  643.  
  644. BEGIN
  645.   RETURN file.pos;
  646. END Position;
  647.  
  648.  
  649. (*-------------------------------------------------------------------------*)
  650.  
  651.  
  652. (*------  Move:  ------*)
  653.  
  654.  
  655. PROCEDURE Move*(VAR file: File; to: LONGINT): BOOLEAN;
  656.  
  657. (* spring an die Stelle to (vom Dateianfang ausgehend). Ergebnis ist TRUE,
  658. wenn alles korrekt verlieft. *)
  659.  
  660. VAR l: LONGINT;
  661.  
  662. BEGIN
  663.   IF NOT EmptyWriteBuf(file)  THEN                        RETURN FALSE END;
  664.   IF (to>file.size) OR (to<0) THEN file.status := toofar; RETURN FALSE END;
  665.   IF d.Seek(file.handle,to,d.beginning)=0 THEN END;
  666.   file.status := ok;
  667.   file.buflen := 0;
  668.   file.bufpos := 0;
  669.   file.pos := to;
  670.   RETURN TRUE;
  671. END Move;
  672.  
  673.  
  674. (*------  Forward:  ------*)
  675.  
  676.  
  677. PROCEDURE Forward*(VAR file: File; to: LONGINT): BOOLEAN;
  678.  
  679. (* überspringt to Bytes. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)
  680.  
  681. BEGIN
  682.   RETURN Move(file,file.pos+to);
  683. END Forward;
  684.  
  685.  
  686. (*------  Backward:  ------*)
  687.  
  688.  
  689. PROCEDURE Backward*(VAR file: File; to: LONGINT): BOOLEAN;
  690.  
  691. (* springt to Bytes zurück . Ergebnis ist TRUE, wenn alles korrekt
  692. verlieft. *)
  693.  
  694. BEGIN
  695.   RETURN Move(file,file.pos-to);
  696. END Backward;
  697.  
  698.  
  699. (*-------------------------------------------------------------------------*)
  700.  
  701. PROCEDURE Delete*(VAR file: File): BOOLEAN;
  702.  
  703. (* schließt und löscht die Datei *)
  704.  
  705. BEGIN
  706.   IF file.handle#NIL THEN IF Close(file) THEN END END;
  707.   RETURN d.DeleteFile(file.name);
  708. END Delete;
  709.  
  710.  
  711. (*-------------------------------------------------------------------------*)
  712.  
  713.  
  714. PROCEDURE Exists*(name: ARRAY OF CHAR): BOOLEAN;
  715.  
  716. (* prüft, ob die Datei mit dem Namen 'name' existiert. *)
  717.  
  718. VAR lock: d.FileLockPtr;
  719.  
  720. BEGIN
  721.   lock := sd.Lock(name,d.sharedLock);
  722.   IF lock#NIL THEN
  723.     sd.UnLock(lock); RETURN TRUE
  724.   ELSE
  725.     RETURN FALSE;
  726.   END;
  727. END Exists;
  728.  
  729.  
  730. END EdFileSystem.
  731.